Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/dialog/dialogjb/dialogjb.frm

Text File | 1995-08-27 | 21.7 KB | 625 lines

'This form should work as a Common Dialog box without the use of any
'VBX's or DLL's.
'The reading of the INI file is optional but may be useful.
'The main form is called frmMain here.  Substitute the appropriate name
'for your program.
'Please note also the file OpenBtn.TXT which gives the commands on the
'Main form that should be used whenever this dialog box is opened
'(whether from a Button, a Menu, or whatever command.)
'This is set up so that the file names are loaded into a Combo Box on the
'Main form.  This can be easily altered to a list box or to some other
'device depending on the nature of your main program and whether you
'want this Common Dialog box to load single files or multiple files.
'You also, of course, may change color, location of controls, fonts, etc.


VERSION 2.00
Begin Form frmDialogJB    'Main form like Dialog Box, uses 3D gray shading
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Select Files" 'Will select more than one file
   ClientHeight    =   4020
   ClientLeft      =   1680
   ClientTop       =   1575
   ClientWidth     =   7365
   ClipControls    =   0   'False
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4425
   HelpContextID   =   200
   Left            =   1620
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4020
   ScaleWidth      =   7365
   Top             =   1230
   Width           =   7485
End
'To save initial directory and hidden/system defaults, you may want to
'use an INI file. I used INICON.VBX because it was easy. Other VBX's
'or Windows API calls can be just as effective.
   Begin Init IniSystem 'VBX control to read INI file info on System files
      Application     =   "MyProgram"
      Filename        =   "MYPROGRM.INI"
      Height          =   420
      Left            =   6480
      Parameter       =   "System"
      Top             =   2880
      Value           =   "0"
      Width           =   420
   End
   Begin Init IniHidden 'VBX control to read INI file info on Hidden files
      Application     =   "MyProgram"
      Filename        =   "MYPROGRM.INI"
      Height          =   420
      Left            =   5880
      Parameter       =   "Hidden"
      Top             =   2880
      Value           =   "0"
      Width           =   420
   End
   Begin Init IniDir 'VBX control to read INI file for Initial Directory
      Application     =   "MyProgram"
      Filename        =   "MYPROGRM.INI"
      Height          =   420
      Left            =   5280
      Parameter       =   "InitDir"
      Top             =   2880
      Value           =   "c:\vb"
      Width           =   420
   End
   Begin CommandButton cmdCancelD1 'Control for Cancel button
      BackColor       =   &H00C0C0C0&
      Cancel          =   -1  'True--Routine cancels if ESC key is pressed
      Caption         =   "&Cancel"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      HelpContextID   =   200 'I used Help Context ID's for this
'You may decide this is optional or may have other ID number
      Left            =   5400
      TabIndex        =   8
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton cmdOKD1 'OK button, loads selected files & returns
'to main screen
      BackColor       =   &H00C0C0C0&
      Caption         =   "&OK"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      HelpContextID   =   200
      Left            =   5400
      TabIndex        =   7 'Keeping tab index order can be helpful
'for those not using a mouse
      Top             =   240
      Width           =   1095
   End
   Begin CheckBox ckSystem  'Use check box for indicating whether System
'files are read by program or not.  If your program never needs to
'read or load System files, you do not need this.
      BackColor       =   &H00C0C0C0&
      Caption         =   "Show System Files"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      HelpContextID   =   550
      Left            =   5400
      TabIndex        =   6
      Top             =   2040
      Width           =   1695
   End
   Begin CheckBox ckHidden 'Use check box for indicating whether Hidden
'files are read by program or not.  If your program never needs to
'read or load Hidden files, you do not need this.
      BackColor       =   &H00C0C0C0&
      Caption         =   "Show Hidden Files"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      HelpContextID   =   550
      Left            =   5400
      TabIndex        =   5
      Top             =   1560
      Width           =   1695
   End
   Begin DriveListBox Drive1 'Drive list box to show which drive you want
'to use. Found in nearly all file dialog boxes.
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   315
      HelpContextID   =   200
      Left            =   2880
      TabIndex        =   4
      Top             =   3240
      Width           =   2055
   End
   Begin DirListBox Dir1 'Directory list box to choose which directory
'you want to read or load files from
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1605
      HelpContextID   =   200
      Left            =   2880
      TabIndex        =   3
      Top             =   960
      Width           =   2055
   End
   Begin FileListBox File1 'List Box for files to read or load
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2565
      HelpContextID   =   200
      Left            =   360
      MultiSelect     =   2  'Extended. This can be an important switch.
'Check Visual Basic Manual for three options--choose one file only or
'two ways to select more than one file. The "Extended" mode is commonly
'used in programs which load or read more than one file at a time (like
'the Windows File Manager).
      TabIndex        =   1 'Note that the Tab Index #1 should be set for
'this list box since this is the one most likely to be used.
      Top             =   960
      Width           =   2055
   End
   Begin TextBox Text1 'Use Text Box so user can enter name of file
'to load. Will also show file or first of group of files selected.
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      HelpContextID   =   200
      Left            =   360
      TabIndex        =   0
      Text            =   "*.*" 'Standard default file name in Text box
      Top             =   480
      Width           =   2055
   End
   Begin Label lblCk 'Label by Check boxes for Hidden & System files
'Not needed if your program never uses Hidden or System files
      BackColor       =   &H00C0C0C0&
      Caption         =   "Show Files:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   5400
      TabIndex        =   12
      Top             =   1200
      Width           =   855
   End
   Begin Label lblDrive  'Label by Drive List Box
      BackColor       =   &H00C0C0C0&
      Caption         =   "Drives:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   2880
      TabIndex        =   11
      Top             =   2880
      Width           =   495
   End
   Begin Label lblDirTop 'Label at top of Directory list box
      BackColor       =   &H00C0C0C0&
      Caption         =   "Directories:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   2880
      TabIndex        =   10
      Top             =   120
      Width           =   855
   End
   Begin Label lblFile 'Label by File List Box
      BackColor       =   &H00C0C0C0&
      Caption         =   "File Names:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   120
      Width           =   855
   End
'The following shapes add 3D effect to gray color of dialog box according to
'more recent Windows fashion (including Windows 95). See cover story of
'March 1995 Visual Basic Programmer's Journal.
   Begin Shape rctCkW
      BorderColor     =   &H00FFFFFF&
      Height          =   1335
      Left            =   5295
      Top             =   1335
      Width           =   1935
   End
   Begin Shape rctDriveW
      BorderColor     =   &H00FFFFFF&
      Height          =   735
      Left            =   2775
      Top             =   3015
      Width           =   2295
   End
   Begin Shape rctDirW
      BorderColor     =   &H00FFFFFF&
      Height          =   2535
      Left            =   2775
      Top             =   255
      Width           =   2295
   End
   Begin Shape rctFileW
      BorderColor     =   &H00FFFFFF&
      Height          =   3495
      Left            =   255
      Top             =   255
      Width           =   2295
   End
   Begin Shape rctCkG
      BorderColor     =   &H00808080&
      Height          =   1335
      Left            =   5280
      Top             =   1320
      Width           =   1935
   End
   Begin Shape rctDriveG
      BorderColor     =   &H00808080&
      Height          =   735
      Left            =   2760
      Top             =   3000
      Width           =   2295
   End
   Begin Label lblDirName 'Label shows directory selected. Use label
'in conjunction with list box. Unlike Text box with file name, user
'does not enter name of directory. (User may put directory in Text box.)
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   2880
      TabIndex        =   2
      Top             =   480
      Width           =   2055
   End
'More 3D highlighting
   Begin Shape rctDirG
      BackColor       =   &H00C0C0C0&
      BorderColor     =   &H00808080&
      Height          =   2535
      Left            =   2760
      Top             =   240
      Width           =   2295
   End
   Begin Shape rctFileG
      BorderColor     =   &H00808080&
      Height          =   3495
      Left            =   240
      Top             =   240
      Width           =   2295
   End
End
Option Explicit
Dim DrNm$ 'Set String name for directory to read
'As stated before, you may use another method of reading INI file if you
'need to.  Just change code as needed.

Sub ckHidden_Click ()
Dim Hidyes% 'Set Integer (Boolean, T-F) for whether Hidden Files are read
If CkHidden.Value = 1 Then 'If you click the Hidden Box on then INI file
'value is changed to reflect this
    IniHidden.Filename = "MYPROGRM.INI"   'Reads INI file value
    IniHidden.Application = "MyProgram"
    IniHidden.Parameter = "Hidden"
    IniHidden.Value = True   'When INI file value is true, then File Box reads
                               'Hidden Files
    File1.Hidden = True
Else  'That is, if the Hidden box is not checked...
    File1.Hidden = False  'INI value is false, and File Box skips Hidden Files
    IniHidden.Filename = "MYPROGRM.INI"
    IniHidden.Application = "MyProgram"
    IniHidden.Parameter = "Hidden"
    IniHidden.Value = False
End If

End Sub

Sub ckSystem_Click ()
Dim Sysyes% 'Set integer (Boolean, T-F) whether or System files are read
If CkSystem.Value = 1 Then 'If user checks the System box...
    IniSystem.Filename = "MYPROGRM.INI"
    IniSystem.Application = "MyProgram"
    IniSystem.Parameter = "System"
    IniSystem.Value = True 'then INI file is changed and
    File1.System = True 'System files are read.
Else 'If System check box is unchecked...
    File1.System = False 'System files are not longer listed
    IniSystem.Filename = "MYPROGRM.INI"
    IniSystem.Application = "MyProgram"
    IniSystem.Parameter = "System"
    IniSystem.Value = False 'and INI file is changed to reflect this.
End If
End Sub

Sub cmdCancelD1_Click ()
    Unload frmDialogJB
    frmMain.LinShadB.Visible = False 'When dialog box is unloaded,
'the shaded line which appears over the main Window to give a 3D shaded
'effect is also closed
End Sub

Sub cmdOKD1_Click ()
'The OK button as with standard dialog normally sends files to main program.
Dim I As Integer, FN  As String 'FN is the File name, I is for the loop
'First do an error check to make sure a file has been loaded.
'If text box is either empty or has the original asterisks, nothing
'is done and nothing happens.
If Text1.Text <> "*.*" And Len(Text1.Text) > 0 Then GoTo Loadfiles
   Dir1_Change
   Exit Sub
Loadfiles:
P$ = File1.Path 'Makes a simpler name for the file box path
'Check for files entered from text box but not file box
Dim Selcount As Integer
Selcount = 0
For I = 0 To File1.ListCount - 1
    If File1.Selected(I) Then
        Selcount = Selcount + 1
    End If
Next I
    If Selcount = 0 Then 'If item was manually entered into text box,
'this sends item to combo box in main program.  Clearly, you may
'choose to use a list box in your main program instead, or you may
'have some other way of loading the file, especially if you are only
'using single files.
        frmMain.cboFile.AddItem Text1.Text
        GoTo Morefile:
    End If

'Add Selected files to frmMain.cboFile
'This adds multiple files to the combo box in your main program
For I = 0 To File1.ListCount - 1
    If File1.Selected(I) Then
        frmMain.cboFile.AddItem File1.List(I)
    End If
Next I
Morefile:
'This adds the path name to the main program.
'It must filter the various ways the directory and drive may be read.
'This insures that there is backslash between the directory and file name.
    frmMain.cboFile.ListIndex = 0
    If Right(File1.Path, 1) <> "\" Then
        FN = File1.Path + "\" + frmMain.cboFile.List(0)
    Else
        FN = File1.Path + frmMain.cboFile.List(0)
    End If
    Unload frmDialogJB
    frmMain.LinShadB.Visible = False  'See note by Cancel command

'Add commands as necessary for main program Window
End Sub

Sub Dir1_Change ()
'Handles changes user makes to directory list box
If Dir1.Path <> Dir1.List(Dir1.ListIndex) Then
    Dir1.Path = Dir1.List(Dir1.ListIndex)
End If
    DrNm$ = Dir1.Path
    lblDirname = DrNm$
    File1.Path = DrNm$
End Sub

Sub Dir1_KeyPress (KeyAscii As Integer)
'If user presses Enter while in Directory List Box, change is made
If KeyAscii = 13 Then
    If Dir1.Path <> Dir1.List(Dir1.ListIndex) Then
        Dir1.Path = Dir1.List(Dir1.ListIndex)
    End If
    DrNm$ = Dir1.Path
    lblDirname = DrNm$
    File1.Path = DrNm$
End If

End Sub

Sub Drive1_Change ()
'Changes drive, and checks to make sure drive is present or functioning
On Error GoTo ErrCheck
    Dir1.Path = Drive1.Drive
    Exit Sub
ErrCheck:
    MsgBox "Drive Error!", 48, "MyProgram Error"
    Exit Sub

End Sub

Sub File1_Click ()
'A single click on a file name in the file list box enters the file name
'into the text box
   Text1 = File1.FileName
End Sub

Sub File1_DblClick ()
'A double click on a file name in the file list box enters the file name
'into the text box and loads or reads the file
    Text1 = File1.FileName
    cmdOKD1_Click
End Sub

Sub File1_KeyPress (KeyAscii As Integer)
'Pressing Enter after choosing a file in the file List box also loads
'or reads that file
    If KeyAscii = 13 Then File1_DblClick
End Sub

Sub Form_Load ()
'When form loads, it reads from the INI file to see three things:
'The initial directory, and whether System and Hidden files are read.
'I used the INICON.VBX system, you may use another VBX or the Windows API
'to get the same result.  Clearly, if you don't need any of these items,
'you don't have to have this part.
Dim InDir$, Sisyes%, Hidyes%
    CenterForm frmDialogJB 'If you have a routine for centering the form
'then use it
    frmDialogJB.Show
'Reads INI to see if System file check box is checked and System files
'Are being read.
    IniSystem.Filename = "MYPROGRM.INI"
    IniSystem.Application = "MyProgram"
    IniSystem.Parameter = "System"
    Sisyes% = IniSystem.Value
If Sisyes% = True Then
    File1.System = True
    CkSystem.Value = 1
Else
    File1.System = False
    CkSystem.Value = 0
End If
'Reads INI to see if Hidden File check box is checked and Hidden files
'are being read
    IniHidden.Filename = "MYPROGRM.INI"
    IniHidden.Application = "MyProgram"
    IniHidden.Parameter = "Hidden"
    Hidyes% = IniHidden.Value
If Hidyes% = True Then
    File1.Hidden = True
    CkHidden.Value = 1
Else
    File1.Hidden = False
    CkHidden.Value = 0
End If
'Read INI file for Initial Directory and sets Directory and Drive list
'boxes to the appropriate drive and directory
    IniDir.Filename = "MYPROGRM.INI"
    IniDir.Application = "MyProgram"
    IniDir.Parameter = "InitDir"
    InDir$ = IniDir.Value
Drive1.Drive = InDir$
Dir1.Path = InDir$
File1.Path = InDir$
lblDirname = InDir$
File1.FileName = ""
End Sub

Sub Form_Paint ()
'This adds 3D shading to Text Boxes, Outlined Labels, and List Boxes
    Call BordGray3d(frmDialogJB)
    Call Go3dGray(frmDialogJB, Text1)
    Call Go3dGray(frmDialogJB, File1)
    Call Go3dGray(frmDialogJB, lblDirname)
    Call Go3dGray(frmDialogJB, Dir1)
    Call Go3dGray(frmDialogJB, Drive1)
End Sub
'Error filters for text entered in box so that file name is legal
'And inadvertent insertions are avoided
Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = 45 And (Shift And 1) = 1 Then KeyCode = 0
End Sub

Sub Text1_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then GoTo Enter 'If Enter key is pressed, action continues
If KeyAscii = 22 Then KeyAscii = 0
If KeyAscii < Asc(" ") Then Exit Sub
If KeyAscii = Asc(".") Then GoTo Period
If KeyAscii > 42 And KeyAscii < 45 Then KeyAscii = 0
If KeyAscii = 47 Then KeyAscii = 0
If KeyAscii > 57 And KeyAscii < 64 Then KeyAscii = 0
If KeyAscii > 90 And KeyAscii < 94 Then KeyAscii = 0
If KeyAscii = 124 Then KeyAscii = 0

Period:     'Check for more than one period
Dim Periods%, Length%, I%
Periods% = 0
Length% = Len(Text1.Text)
For I% = 1 To Length%
    If Mid$(Text1.Text, I%, 1) = "." Then
        Periods% = Periods% + 1
    End If
Next I%
If Periods% >= 1 Then KeyAscii = 0

'You may need the following keys filtered also
If KeyAscii >= Asc("0") Or KeyAscii <= Asc("9") Then GoTo OVR1
If KeyAscii > 124 Then GoTo OVR1
If KeyAscii > 35 And KeyAscii < 42 Then GoTo OVR1:
If KeyAscii = 33 Then GoTo OVR1
If KeyAscii > 63 And KeyAscii < 91 Then GoTo OVR1
If KeyAscii > 93 And KeyAscii < 124 Then GoTo OVR1
OVR1:
'Include other conditions as necessary
     If Text1.SelLength = CLng(0) And KeyAscii >= 32 Then
        Text1.SelLength = CLng(1)
        End If
   ' End If 'If other conditions
Exit Sub
Enter:
'Enters file or files into main program
Dim FN As String
    P$ = File1.Path
    frmMain.cboFile.AddItem Text1.Text
    frmMain.cboFile.ListIndex = 0
    If Right(File1.Path, 1) <> "\" Then
        FN = File1.Path + "\" + frmMain.cboFile.List(0)
    Else
        FN = File1.Path + frmMain.cboFile.List(0)
    End If
'Add other information to main program as necessary

    Unload frmDialogJB
    frmMain.LinShadB.Visible = False
End Sub